home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / vb3 / pro4 / atomic.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-08-28  |  17.3 KB  |  489 lines
  1. VERSION 2.00
  2. Begin Form Atomic 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Call the Atomic Clock"
  6.    ClientHeight    =   3975
  7.    ClientLeft      =   2475
  8.    ClientTop       =   945
  9.    ClientWidth     =   4695
  10.    ClipControls    =   0   'False
  11.    Height          =   4410
  12.    Left            =   2400
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   3975
  17.    ScaleWidth      =   4695
  18.    Top             =   585
  19.    Width           =   4845
  20.    Begin MSComm Comm1 
  21.       InBufferSize    =   2048
  22.       Interval        =   1000
  23.       Left            =   3390
  24.       NullDiscard     =   -1  'True
  25.       OutBufferSize   =   2048
  26.       RTSEnable       =   -1  'True
  27.       Top             =   1125
  28.    End
  29.    Begin SSCheck DST 
  30.       Caption         =   "Use Daylight Savings Time"
  31.       Height          =   285
  32.       Left            =   225
  33.       TabIndex        =   4
  34.       Top             =   960
  35.       Width           =   2640
  36.    End
  37.    Begin ComboBox TimeZone 
  38.       BackColor       =   &H00FFFFFF&
  39.       Height          =   300
  40.       Left            =   375
  41.       Style           =   2  'Dropdown List
  42.       TabIndex        =   3
  43.       Top             =   450
  44.       Width           =   4065
  45.    End
  46.    Begin CommandButton Command1 
  47.       Cancel          =   -1  'True
  48.       Caption         =   "Cancel"
  49.       Height          =   345
  50.       Index           =   2
  51.       Left            =   2370
  52.       TabIndex        =   1
  53.       Top             =   3300
  54.       Width           =   2085
  55.    End
  56.    Begin CommandButton Command1 
  57.       Caption         =   "Dial"
  58.       Default         =   -1  'True
  59.       Height          =   345
  60.       Index           =   1
  61.       Left            =   2370
  62.       TabIndex        =   0
  63.       Top             =   2790
  64.       Width           =   2070
  65.    End
  66.    Begin CommandButton Command1 
  67.       Caption         =   "Reset Defaults"
  68.       Height          =   345
  69.       Index           =   0
  70.       Left            =   2370
  71.       TabIndex        =   12
  72.       Top             =   2280
  73.       Width           =   2070
  74.    End
  75.    Begin SSFrame Frame3D1 
  76.       Caption         =   "COM Port"
  77.       ForeColor       =   &H00000000&
  78.       Height          =   1530
  79.       Left            =   255
  80.       TabIndex        =   7
  81.       Top             =   2190
  82.       Width           =   1965
  83.       Begin SSOption ComPort 
  84.          Caption         =   "COM&4:"
  85.          ForeColor       =   &H00000000&
  86.          Height          =   240
  87.          Index           =   3
  88.          Left            =   135
  89.          TabIndex        =   11
  90.          Top             =   1185
  91.          Width           =   780
  92.       End
  93.       Begin SSOption ComPort 
  94.          Caption         =   "COM&3:"
  95.          ForeColor       =   &H00000000&
  96.          Height          =   240
  97.          Index           =   2
  98.          Left            =   135
  99.          TabIndex        =   10
  100.          Top             =   885
  101.          Width           =   780
  102.       End
  103.       Begin SSOption ComPort 
  104.          Caption         =   "COM&2:"
  105.          ForeColor       =   &H00000000&
  106.          Height          =   240
  107.          Index           =   1
  108.          Left            =   135
  109.          TabIndex        =   9
  110.          Top             =   585
  111.          Width           =   780
  112.       End
  113.       Begin SSOption ComPort 
  114.          Caption         =   "COM&1:"
  115.          ForeColor       =   &H00000000&
  116.          Height          =   240
  117.          Index           =   0
  118.          Left            =   135
  119.          TabIndex        =   8
  120.          Top             =   285
  121.          Width           =   780
  122.       End
  123.    End
  124.    Begin TextBox DialString 
  125.       Height          =   300
  126.       Left            =   375
  127.       TabIndex        =   6
  128.       Text            =   "ATDT 1 303 494-4774"
  129.       Top             =   1710
  130.       Width           =   4080
  131.    End
  132.    Begin Label Status 
  133.       Alignment       =   1  'Right Justify
  134.       BackStyle       =   0  'Transparent
  135.       Height          =   240
  136.       Left            =   1125
  137.       TabIndex        =   13
  138.       Top             =   15
  139.       Width           =   3300
  140.    End
  141.    Begin Label Label1 
  142.       BackStyle       =   0  'Transparent
  143.       Caption         =   "Modem Dial String"
  144.       Height          =   210
  145.       Index           =   1
  146.       Left            =   225
  147.       TabIndex        =   5
  148.       Top             =   1440
  149.       Width           =   2145
  150.    End
  151.    Begin Label Label1 
  152.       BackStyle       =   0  'Transparent
  153.       Caption         =   "Time Zone"
  154.       Height          =   240
  155.       Index           =   0
  156.       Left            =   195
  157.       TabIndex        =   2
  158.       Top             =   165
  159.       Width           =   1320
  160.    End
  161. Option Explicit
  162. Dim ControlsDisabled As Integer
  163. Dim InString As String
  164. Dim TString As String
  165. Dim Aborted As Integer
  166.                              'DESCRIPTION OF THE
  167.                  'AUTOMATED COMPUTER TELEPHONE SERVICE (ACTS)
  168. 'The following is transmitted (at 1200 Baud) after completion of the
  169. 'telephone connection.
  170.              '? = HELP
  171.              'National Institute of Standards and Technology
  172.              'Telephone Time Service
  173.                                      'D  L D
  174.               'MJD  YR MO DA H  M  S  ST S UT1 msADV        <OTM>
  175.              '47999 90-04-18 21:39:15 50 0 +.1 045.0 UTC(NIST) *
  176.              '47999 90-04-18 21:39:16 50 0 +.1 045.0 UTC(NIST) *
  177.              '47999 90-04-18 21:39:17 50 0 +.1 045.0 UTC(NIST) *
  178.              '47999 90-04-18 21:39:18 50 0 +.1 045.0 UTC(NIST) *
  179.              '47999 90-04-18 21:39:19 50 0 +.1 037.6 UTC(NIST) #
  180.              '47999 90-04-18 21:39:20 50 0 +.1 037.6 UTC(NIST) #
  181.              'etc..etc...etc.......
  182. 'UTC = Universal Time Coordinated, the official world time referred to the
  183. 'zero meridian.
  184. '_________________________________________________________________________
  185. 'DST = Daylight savings time characters, valid for the continental U.S., are
  186. 'set as follows:
  187.   '00 = We are on standard time (ST).    50 = We are on DST.
  188.   '99 to 51 = Now on ST, go to DST when your local time is 2:00 am and the
  189.     'count is 51.  The count is decremented daily at 00 (UTC).
  190.   '49 to 01 = Now on DST, go to ST when your local time is 2:00 am and the
  191.     'count is 01.  The count is decremented daily at 00 (UTC).
  192. 'The two DST characters provide up to 48 days advance notice of a change in
  193. 'time.  The count remains at 00 or 50 at other times.
  194. '_________________________________________________________________________
  195. 'LS = Leap second flag is set to "1" to indicate that a leap second is to be
  196. 'added as 23:59:60 (UTC) on the last day of the current UTC month.  The LS
  197. 'flag will be reset to "0" starting with 23:59:60 (UTC).  The flag will
  198. 'remain on for the entire month before the second is added.  Leap seconds
  199. 'are added as needed at the end of any month.  Usually June and/or December
  200. 'are chosen.
  201. '__________________________________________________________________________
  202. 'DUT1 = Approximate difference between earth rotation time (UT1) and UTC, in
  203. 'steps of 0.1 second.         DUT1 = UT1 - UTC
  204. '___________________________________________________________________________
  205. 'MJD = Modified Julian Date, often used to tag certain scientific data.
  206. '___________________________________________________________________________
  207. 'The full time format is sent at 1200 Baud, 8 bit, 1 stop, no parity.
  208. 'The format at 300 Baud is also 8 bit, 1 stop, no parity.
  209. 'At 300 Baud the MJD and DUT1 values are deleted and the
  210. 'time is transmitted only on even seconds.
  211. '___________________________________________________________________________
  212. 'Maximum on line time will be 56 seconds.  If all lines are busy at any time,
  213. 'the oldest call will be terminated if it has been on line more than 28
  214. 'seconds, else, the call that first reaches 28 seconds will be terminated.
  215. '___________________________________________________________________________
  216. 'Current time is valid at the "on-time" marker (OTM), either "*" or "#".
  217. 'The nominal on-time marker (*) will be transmitted 45 ms early to account
  218. 'for the 8 ms required to send 1 character at 1200 Baud, plus an additional
  219. '7 ms for delay from NIST to the user, and approximately 30 ms "scrambler"
  220. 'delay inherent in 1200 Baud modems.  If the caller echoes all characters,
  221. 'NIST will measure the round trip delay and advance the on-time marker so
  222. 'that the midpoint of the stop bit arrives at the user on time.  The amount
  223. 'of msADV will reflect the actual required advance in milliseconds and the
  224. 'OTM will be a "#".  The NIST system requires 4 or 5 consecutive delay
  225. 'measurements which are consistent before switching from "*" to "#".
  226. 'If the user has a 1200 Baud modem with the same internal delay as that used
  227. 'by NIST, then the "#" OTM should arrive at the user within +-2 ms of the
  228. 'correct time.  However, NIST has studied different brands of 1200 Baud
  229. 'modems and found internal delays from 24 ms to 40 ms and offsets of the
  230. '"#" OTM of +-10 ms.  For many computer users, +-10 ms accuracy should be
  231. 'more than adequate since many computer internal clocks can only be set with
  232. 'granularity of 20 to 50 ms.  In any case, the repeatability of the offset
  233. 'for the "#" OTM should be within +-2 ms, if the dial-up path is reciprocal
  234. 'and the user doesn't change the brand or model of modem used. This should
  235. 'be true even if the dial-up path on one day is a land-line of less than
  236. '40 ms (one way) and on the next day is a satellite link of 260 to 300 ms.
  237. 'In the rare event that the path is one way by satellite and the other way
  238. 'by land line with a round trip measurement in the range of 90 to 260 ms,
  239. 'the OTM will remain a "*" indicating 45 ms advance.
  240. '___________________________________________________________________________
  241. 'For user comments write:
  242. 'NIST-ACTS
  243. 'Time and Frequency Division
  244. 'Mail Stop 524
  245. '325 Broadway
  246. 'Boulder, CO  80303
  247. 'Software for setting (PC)DOS compatable machines is available
  248. 'on a 360-kbyte diskette for $35.00 from:
  249. 'NIST Office of Standard Reference Materials
  250. 'B311-Chemistry Bldg, NIST, Gaithersburg, MD, 20899, (301) 975-6776
  251. '--------------------------------------------------------------------------
  252. Sub Command1_Click (Index As Integer)
  253. Dim StartTime As Double
  254. Dim I As Integer
  255. Dim NewD As Double
  256. Dim OldD As Double
  257. Dim DSTFlag As String
  258. Dim OffBy As String
  259. If Index = 0 Then  'Reset Defaults
  260.    ResetDefaults
  261.    Status.Caption = ""
  262. End If
  263. If Index = 1 Then  'Dial
  264.    SaveModemSettings
  265.    Aborted = False
  266.    Status.Caption = ""
  267.    Command1(0).Enabled = False
  268.    Command1(1).Enabled = False
  269.    TimeZone.Enabled = False
  270.    DST.Enabled = False
  271.    DialString.Enabled = False
  272.    Frame3D1.Enabled = False
  273.    ControlsDisabled = True
  274.    On Local Error GoTo ErrHndl
  275.    For I% = 0 To 3
  276.      If ComPort(I%).Value Then comm1.CommPort = I% + 1
  277.    Next I%
  278.    If Aborted Then Exit Sub
  279.    comm1.Settings = "1200,N,8,1"
  280.    If Aborted Then Exit Sub
  281.    comm1.PortOpen = True
  282.    If Aborted Then Exit Sub
  283.    comm1.Output = DialString.Text + Chr$(13) + Chr(10)
  284.    StartTime = Timer
  285.    LastTime = 0
  286.    Do
  287.       DoEvents
  288.       If LastTime <> Int(Timer) Then
  289.          If Not Aborted Then Status.Caption = "Connecting - " + Format$(75 - Int(Timer - StartTime)) + " seconds until timeout."
  290.          LastTime = Int(Timer)
  291.       End If
  292.    Loop Until comm1.InBufferCount >= 600 Or ((Timer - StartTime) > 75) Or Aborted
  293.    If Aborted Then Exit Sub
  294.    If (Timer - StartTime) > 75 Then
  295.          Status.Caption = "Timed out."
  296.          Exit Sub
  297.    End If
  298.    Status.Caption = "Setting time."
  299.    InString$ = comm1.Input
  300.    If Aborted Then Exit Sub
  301.    InString$ = Mid$(InString$, InStr(InString$, "*") + 1, 80)
  302.    NewD = DateValue(Mid$(InString$, 12, 2) + "/" + Mid$(InString$, 15, 2) + "/" + Mid$(InString$, 9, 2))
  303.    NewD = NewD + TimeValue(Mid$(InString$, 18, 8))
  304.    NewD = NewD - (TimeZone.ListIndex - 11) * (1 / 24)
  305.    DSTFlag$ = Mid$(InString$, 27, 2)
  306.    'If ((DSTFlag >= "01") And (DSTFlag <= "50")) Then
  307.    '   NewD = NewD - (1 / 24)
  308.    'End If
  309.    If DST.Value Then
  310.       NewD = NewD + (1 / 24)
  311.    End If
  312.    OldD = Date + Time
  313.    If Year(NewD) >= 1993 Then
  314.       Date = Format$(NewD, "mm/dd/yy")
  315.       Time = Format$(NewD, "hh:mm:ss")
  316.       If OldD > NewD Then
  317.          OffBy = "fast"
  318.       Else
  319.          OffBy = "slow"
  320.       End If
  321.       MsgBox "Time set to " + Format$(NewD, "hh:mm:ss") + ".  Clock was " + OffBy$ + " by " + Format$(Abs(NewD - OldD), "hh:mm:ss") + "."
  322.       Screen.MousePointer = 11
  323.       AtomicTimeWasSet = True
  324.       Status.Caption = "Time set."
  325.    Else
  326.       MsgBox "Error getting date and time."
  327.    End If
  328.    If Aborted Then Exit Sub
  329.    Screen.MousePointer = 11
  330.    HangUp
  331.    If Aborted Then Exit Sub
  332.    On Local Error Resume Next
  333.    Screen.MousePointer = 0
  334.    Unload Atomic
  335. End If
  336. If Index = 2 Then  'Cancel
  337.    If ControlsDisabled Then
  338.       HangUp
  339.       EnableControls
  340.       Aborted = True
  341.       Status.Caption = "Aborted."
  342.    Else
  343.       Unload Atomic
  344.    End If
  345. End If
  346. EnableControls
  347. Exit Sub
  348. ErrHndl:
  349. MsgBox "Error: " + Error(Err)
  350. EnableControls
  351. Exit Sub
  352. End Sub
  353. Sub EnableControls ()
  354.    Command1(0).Enabled = True
  355.    Command1(1).Enabled = True
  356.    TimeZone.Enabled = True
  357.    DST.Enabled = True
  358.    DialString.Enabled = True
  359.    Frame3D1.Enabled = True
  360.    ControlsDisabled = False
  361. End Sub
  362. Sub Form_Load ()
  363. Atomic.Left = Settings.Left + (Settings.Width / 2) - (Atomic.Width / 2)
  364. Atomic.Top = Settings.Top + (Settings.Height / 2) - (Atomic.Height / 2)
  365. TimeZone.AddItem "Greenwich + 11"
  366. TimeZone.AddItem "Greenwich + 10"
  367. TimeZone.AddItem "Greenwich + 9"
  368. TimeZone.AddItem "Greenwich + 8"
  369. TimeZone.AddItem "Greenwich + 7"
  370. TimeZone.AddItem "Greenwich + 6"
  371. TimeZone.AddItem "Greenwich + 5"
  372. TimeZone.AddItem "Greenwich + 4"
  373. TimeZone.AddItem "Greenwich + 3"
  374. TimeZone.AddItem "Greenwich + 2"
  375. TimeZone.AddItem "Greenwich + 1"
  376. TimeZone.AddItem "Greenwich"
  377. TimeZone.AddItem "Greenwich - 1"
  378. TimeZone.AddItem "Greenwich - 2"
  379. TimeZone.AddItem "Greenwich - 3"
  380. TimeZone.AddItem "Atlantic Standard Time (4)"
  381. TimeZone.AddItem "Eastern Standard Time"
  382. TimeZone.AddItem "Central Time"
  383. TimeZone.AddItem "Mountain Time"
  384. TimeZone.AddItem "Pacific Time"
  385. TimeZone.AddItem "Yukon Standard Time"
  386. TimeZone.AddItem "Alaska-Hawaii Standard Time"
  387. TimeZone.AddItem "Nome Standard Time"
  388. TimeZone.AddItem "Greenwich - 12"
  389. ResetDefaults
  390. LoadModemSettings
  391. 'Atomic.Show 1
  392. 'Command1(1).SetFocus
  393. End Sub
  394. Sub HangUp ()
  395.    Dim StartTime As Double
  396.    Dim I As Integer
  397.    Dim Ret As Integer
  398.    'Josh version  -
  399.    'comm1.PortOpen = False
  400.    'Exit Sub
  401.    'Beep
  402.    On Local Error GoTo ErrHndl2
  403.    'comm1.Output = "+++"
  404.    'StartTime = Timer
  405.    'While Timer - StartTime < .5
  406.    '  DoEvents
  407.    'Wend
  408.    'comm1.Output = "ATH0" + Chr$(13) + Chr(10)
  409.    comm1.Output = ""
  410.    For I% = 1 To 3
  411.    StartTime = Timer
  412.    TString$ = comm1.Input
  413.    comm1.Output = "+"
  414.    While Timer - StartTime < .25
  415.      DoEvents
  416.    Wend
  417.    Next I%
  418.    'Do
  419.    '   DoEvents
  420.    'Loop Until comm1.InBufferCount >= 2
  421.    StartTime = Timer
  422.    While Timer - StartTime < 3#
  423.      DoEvents
  424.    Wend
  425.    TString$ = comm1.Input
  426.    comm1.Output = "ATH0" + Chr(13) + Chr(10)
  427.    StartTime = Timer
  428.    Do
  429.       DoEvents
  430.    Loop Until comm1.InBufferCount >= 2 Or (Timer - StartTime) > 5
  431.    TString$ = comm1.Input
  432.    StartTime = Timer
  433.    While Timer - StartTime < 1#
  434.      DoEvents
  435.    Wend
  436.    '3/28/92 version
  437.    comm1.PortOpen = False
  438.    Exit Sub
  439.    comm1.Output = "+++"
  440.    StartTime = Timer
  441.    While Timer - StartTime < .5
  442.      DoEvents
  443.    Wend
  444.    comm1.Output = "ATH0" + Chr$(13) + Chr(10)
  445.    Ret = comm1.DTREnable     'Save current setting
  446.    comm1.DTREnable = True    'Turn DTR on
  447.      DoEvents
  448.    comm1.DTREnable = False   'Turn DTR off
  449.      DoEvents
  450.    comm1.DTREnable = Ret     'Restore old setting
  451.    comm1.PortOpen = False
  452. ErrHndl2:
  453.   EnableControls
  454.   Exit Sub
  455. End Sub
  456. Sub LoadModemSettings ()
  457. Dim lpReturnedString As String * 100
  458. Dim a As Integer
  459. lpReturnedString = Space$(100)
  460. a% = MyGetProfileString("AllTheTime", "TimeZoneIndex", "16", lpReturnedString$, 100)
  461. TimeZone.ListIndex = Val(lpReturnedString)
  462. a% = MyGetProfileString("AllTheTime", "DST", "0", lpReturnedString$, 100)
  463. DST.Value = Val(lpReturnedString)
  464. a% = MyGetProfileString("AllTheTime", "DialString", "ATDT 1 303 494-4774", lpReturnedString$, 100)
  465. DialString.Text = lpReturnedString
  466. a% = MyGetProfileString("AllTheTime", "ComPort", "0", lpReturnedString$, 100)
  467. ComPort(Val(lpReturnedString)).Value = True
  468. End Sub
  469. Sub ResetDefaults ()
  470.    TimeZone.ListIndex = 16
  471.    DST.Value = 0
  472.    DialString.Text = "ATDT 1 303 494-4774"
  473.    ComPort(0).Value = True
  474.    'LoadModemSettings
  475. End Sub
  476. Sub SaveModemSettings ()
  477. Dim a As Integer
  478. Dim M As String
  479. Dim I As Integer
  480. a% = WritePrivateProfileString("AllTheTime", "TimeZoneIndex", TimeZone.ListIndex, "ATT.INI")
  481. a% = WritePrivateProfileString("AllTheTime", "DST", DST.Value, "ATT.INI")
  482. a% = WritePrivateProfileString("AllTheTime", "DialString", DialString.Text, "ATT.INI")
  483. M$ = "0"
  484. For I% = 0 To 3
  485.    If ComPort(I%).Value Then M$ = Str$(I%)
  486. Next I%
  487. a% = WritePrivateProfileString("AllTheTime", "ComPort", M$, "ATT.INI")
  488. End Sub
  489.